home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbbas10 / common01.bas next >
Encoding:
BASIC Source File  |  1995-05-09  |  9.0 KB  |  195 lines
  1. Option Explicit
  2. '****************************************************
  3. '* COMMON01.BAS Version 1.0 Date: 3/30/94           *
  4. '* DPM Computer Solutions                           *
  5. '* 8430-D Summerdale Road San Diego CA 92126-5415   *
  6. '* InterNet: DPMCS@HIGH-COUNTRY.COM                 *
  7. '* Compuserve: 74227,1557                           *
  8. '****************************************************
  9. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal NewString As String, ByVal FileName As String) As Integer
  10. Declare Function GetPrivateProfilestring Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal default As String, ByVal ReturnedString As String, ByVal MAXSIZE As Integer, ByVal FileName As String) As Integer
  11. Declare Function GetKeyState Lib "User" (ByVal NVirtKey%) As Integer
  12.  
  13. '*******************************************************
  14. '* Procedure Name: AppRunning                          *
  15. '*-----------------------------------------------------*
  16. '* Created: 2/8/94    By: MSDN                         *
  17. '* Modified:          By:                              *
  18. '*=====================================================*
  19. '*Checks to see if the current application is already  *
  20. '*running. To use just call the sub. If the application*
  21. '*is already running, it will end the current          *
  22. '*application.                                         *
  23. '*                                                     *
  24. '*******************************************************
  25. Sub AppRunning ()
  26.     Dim sMSG As String
  27.     If APP.PrevInstance Then
  28.     sMSG = APP.EXEName & " already running! "
  29.        MsgBox sMSG, 4112
  30.     End
  31.     End If
  32. End Sub
  33.  
  34. '*******************************************************
  35. '* Procedure Name: CenterForm                          *
  36. '*-----------------------------------------------------*
  37. '* Created: 2/10/94   By: VB Programmers Journal       *
  38. '* Modified: 4/24/94  By: David McCarter               *
  39. '*=====================================================*
  40. '*This code will center a form in the center of the    *
  41. '*screen. To use it, just call the sub and pass it the *
  42. '*form name [Call CenterForm main]                     *
  43. '*                                                     *
  44. '*                                                     *
  45. '*******************************************************
  46. Sub CenterForm (frmIN As Form)
  47.     Dim iTop, iLeft As Integer
  48.  
  49.     If frmIN.WindowState <> 0 Then Exit Sub
  50.     iTop = (Screen.Height - frmIN.Height) \ 2
  51.     iLeft = (Screen.Width - frmIN.Width) \ 2
  52.     
  53.     If iTop And iLeft Then
  54.     frmIN.Move iLeft, iTop
  55.     End If
  56. End Sub
  57.  
  58. '*******************************************************
  59. '*                                                     *
  60. '*      Procedure Name:CenterMDIChild                  *
  61. '*                                                     *
  62. '*             Created:2/10/94       By:VB Prog Journl *
  63. '*            Modified:              By:               *
  64. '*                                                     *
  65. '*            Comments:                                *
  66. '*                                                     *
  67. '*******************************************************
  68. '*******************************************************
  69. '* Procedure Name: CenterMDIChild                      *
  70. '*-----------------------------------------------------*
  71. '* Created: 2/10/94   By: VB Programmers Journal       *
  72. '* Modified: 3/24/94  By: D. McCarter                  *
  73. '*=====================================================*
  74. '* Centers a child form within a parent MDI form. To   *
  75. '* use, call the sub and pass it the parent form name  *
  76. '* and the child form name [CenterMDIChild form1 form2]*
  77. '*                                                     *
  78. '*                                                     *
  79. '*******************************************************
  80. Sub CenterMDIChild (frmParent As Form, frmChild As Form)
  81.     Dim iTop, iLeft As Integer
  82.     If frmParent.WindowState <> 0 Or frmChild.WindowState <> 0 Then Exit Sub
  83.     iTop = (frmParent.ScaleHeight - frmChild.Height) \ 2
  84.     iLeft = (frmParent.ScaleWidth - frmChild.Width) \ 2
  85.  
  86.     If iTop And iLeft Then
  87.     frmChild.Move iLeft, iTop
  88.     End If
  89. End Sub
  90.  
  91. '*******************************************************
  92. '* Procedure Name: CutCopyPaste                        *
  93. '*-----------------------------------------------------*
  94. '* Created:           By: VB Help File                 *
  95. '* Modified:          By:                              *
  96. '*=====================================================*
  97. '*This procedure puts all the cut,copy paste commands  *
  98. '*in one place. To use, just call the sub and pass it  *
  99. '*your choice- 0=Cut, 1=Copy, 2=Paste, 3=Delete,       *
  100. '*[Call CutCopyPaste 2]                                *
  101. '*                                                     *
  102. '*******************************************************
  103. Sub CutCopyPaste (iChoice As Integer)
  104.     ' ActiveForm refers to the active form in the MDI form.
  105.     If TypeOf Screen.ActiveControl Is TextBox Then
  106.     Select Case iChoice
  107.             Case 0          ' Cut.
  108.             ' Copy selected text to Clipboard.
  109.             Clipboard.SetText Screen.ActiveControl.SelText
  110.             ' Delete selected text.
  111.             Screen.ActiveControl.SelText = ""
  112.             Case 1          ' Copy.
  113.             ' Copy selected text to Clipboard.
  114.             Clipboard.SetText Screen.ActiveControl.SelText
  115.             Case 2          ' Paste.
  116.             ' Put Clipboard text in text box.
  117.             Screen.ActiveControl.SelText = Clipboard.GetText()
  118.             Case 3          ' Delete.
  119.             ' Delete selected text.
  120.             Screen.ActiveControl.SelText = ""
  121.     End Select
  122.     End If
  123. End Sub
  124.  
  125. '*******************************************************
  126. '* Procedure Name: GetAppPath                          *
  127. '*-----------------------------------------------------*
  128. '* Created: 3/24/94   By: David McCarter               *
  129. '* Modified:          By:                              *
  130. '*=====================================================*
  131. '*Returns the application path with a trailing \.      *
  132. '*To use, call the function [SomeString=GetAppPath()]  *
  133. '*                                                     *
  134. '*                                                     *
  135. '*                                                     *
  136. '*******************************************************
  137. Function GetAPPPath () As String
  138.     Dim sTemp As String
  139.     sTemp = APP.Path
  140.     If Right$(sTemp, 1) <> "\" Then sTemp = sTemp + "\"
  141.     GetAPPPath = sTemp
  142. End Function
  143.  
  144. '*******************************************************
  145. '* Procedure Name: ReadINI                             *
  146. '*-----------------------------------------------------*
  147. '* Created:           By: Daniel Bowen                 *
  148. '* Modified: 3/24/94  By: David McCarter               *
  149. '*=====================================================*
  150. '*Returns a string from an INI file. To use, call the  *
  151. '*functions and pass it the AppName, KeyName and INI   *
  152. '*File Name, [sReg=ReadINI(App1,Key1,INIFile)]. If you *
  153. '*need the returned value to be a integer then use the *
  154. '*val command.                                         *
  155. '*******************************************************
  156. Function ReadINI (AppName, KeyName, FileName As String) As String
  157.     Dim sRet As String
  158.     sRet = String(255, Chr(0))
  159.     ReadINI = Left(sRet, GetPrivateProfilestring(AppName, ByVal KeyName, "", sRet, Len(sRet), FileName))
  160. End Function
  161.  
  162. '*******************************************************
  163. '* Procedure Name: SelectText                          *
  164. '*-----------------------------------------------------*
  165. '* Created: 2/14/94   By: David McCarter               *
  166. '* Modified:          By:                              *
  167. '*=====================================================*
  168. '*Selects all the text in a text box. Call it when the *
  169. '*text box get focus, [SelectText Text1.text]          *
  170. '*                                                     *
  171. '*                                                     *
  172. '*                                                     *
  173. '*******************************************************
  174. Sub SelectText (ctrIn As Control)
  175.     ctrIn.SelStart = 0
  176.     ctrIn.SelLength = Len(ctrIn.Text)
  177. End Sub
  178.  
  179. '*******************************************************
  180. '* Procedure Name: WriteINI                            *
  181. '*-----------------------------------------------------*
  182. '* Created: 2/10/94   By: David McCarter               *
  183. '* Modified:          By:                              *
  184. '*=====================================================*
  185. '*Writes a string to an INI file. To use, call the     *
  186. '*function and pass it the AppName, KeyName, the New   *
  187. '*String and the INI File Name,                        *
  188. '*[R=WriteINI(App1,Key1,sReg,INIFile)]. Returns a 1 if *
  189. '*there were no errors and a 0 if there were errors.   *
  190. '*******************************************************
  191. Function WriteINI (AppName, KeyName, NewString, FileName As String) As Integer
  192.     WriteINI = WritePrivateProfileString(AppName, KeyName, NewString, FileName)
  193. End Function
  194.  
  195.